home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / System source / Frontend < prev    next >
Text File  |  1998-01-18  |  7KB  |  327 lines
  1. \ Front end for Mops.
  2.  
  3. \ EVENTLOOP is a word you can use in installed applications, or during
  4. \ testing if you have other windows up besides fWind.  If one of the
  5. \ other windows is in front, typed keys are sent to it via KEY:.  If
  6. \ fWind is in front, typed keys are interpreted.  Your other windows
  7. \ will need an Activate handler which calls EventLoop.
  8.  
  9. : EVENTLOOP            \ 30Apr94 DBH, incredibly simple
  10.     BEGIN
  11.         next: fevent        \ next: no longer returns a boolean
  12.     AGAIN ;
  13.  
  14.  
  15. \ Some objects needed by QE and TEfwindMod
  16.  
  17.         handle    QEhand        \ a place for the handle passed in from Quick Edit
  18.         string+    QEstr
  19.  
  20. false    value    ClrStk?        \ true if we're to clear stack on next idle
  21.                             \  or update
  22.  
  23. ' drop    vect    .CELL
  24.  
  25. : (.CELL)      \ ( adr -- )
  26.     @ .  ;
  27.  
  28. ' (.cell) -> .cell            \ This is enhanced when FP loaded
  29.  
  30.  
  31. window    DW                    \ For display of source text during debugging
  32.  
  33. forward  setTW
  34.  
  35. from EXTRASMOD 
  36.     IMPORT{    l rl cl fm need included
  37.             +log -log  (create_log)  (write_log)
  38.             locate_src addr>curs move_curs ?open_in_QE
  39.             edit  openSource  def??
  40.             redraw  use_module
  41.             1up 1dn 1lft 1rt  homex end  defnup defndn selectdw
  42.             prof_str  }
  43.  
  44. : LOCATE    openSource  ;        \ a better name, I think
  45.  
  46. :f CREATE_LOG    (create_log)  ;f
  47. :f WRITE_LOG    (write_log)   ;f
  48.  
  49. compile: extrasMod
  50.  
  51. ' null    vect    ABOUTVEC    \ So AppleMen can be reused as is by
  52.                             \  applications.
  53.                             
  54. ' bye    vect    BYEVEC        \ Our new TE interface needs to do some extra things
  55.  
  56.  
  57. \ Define the menus for the Mops menu bar:
  58.  
  59. 2    AppleMenu    APPLEMEN
  60. 6    menu        FILEMEN
  61. 9    EditMenu    EDITMEN
  62. 3    menu        LISTMEN
  63. 3    menu        SHOWMEN
  64. 6    menu        UTILMEN
  65.  
  66.  
  67. (*
  68. \ PowerPC assembler - now moved to file ppc1
  69.  
  70. from pasmMod import{    :PPC_code  ;PPC_code
  71.                         disasm  disasm_word  disasm_xt
  72.                         disasm_rng  disasm_cnt  disasm_one
  73.                         set_disasm_call_range  }
  74.  
  75. compile: pasmMod
  76.  
  77. *)
  78.  
  79.  
  80. \ Support code for our TEwind interface:
  81.  
  82. string+ TWstr
  83.  
  84. forward  NEWVECS
  85. forward  OLDVECS
  86.  
  87. false    value    PROMPT?
  88.  
  89. forward  run_TE
  90. forward  .room
  91. forward     doPref
  92. forward  nimpl
  93. forward  flush_TWstr
  94.  
  95.  
  96. from TEFwindMod import{  do_run_TE  TEFwind  bye+  evalFromQE
  97.                         xUndo xCut xCopy xPaste xClear xSelAll }
  98.  
  99. from  FEMOD    import{  (about)
  100.                     enFW disFW save stdSave doSave
  101.                     doUndo doCut doCopy doPaste doClear doSelAll xPref
  102.                     doOlist  doClist  x.room xNimpl
  103.                     Lecho  doPurge
  104.                     get_appl_name get_appl_vers get_appl_sig
  105.                     set_appl_name set_appl_vers set_appl_sig
  106.                     run_FE  }
  107.  
  108. :f .room    x.room    ;f
  109. :f doPref    xPref   ;f
  110. :f nimpl    xNimpl  ;f
  111.  
  112. compile: FEmod
  113. compile: TEFwindMod
  114.  
  115. lock: TEFwindMod
  116.  
  117. TEFwind      TW
  118.  
  119.     screenbits    true  setGrow: tw
  120.                 true  setZoom: tw
  121.  
  122.  
  123. : TWPORT?        \ The vecs only need to be different if TW is the grafport
  124.     savePort  thePort @  addr: tw  = ;
  125.  
  126. : ERR_SRC
  127.     topFile nilP <>
  128.     IF      \ We try to open the source in QE.  We don't use LOCATE_SRC
  129.             \  since here we only want a source display if it's QE.
  130.         topFile ?open_in_QE
  131.         pos: topFile  move_curs
  132.     THEN
  133.     TWport?
  134.     IF        -echo   0 -> (err#)        \ Clear error indicator from AppleEvents
  135.             dflt-err                \ Display error info and abort
  136.     ELSE    (ddie)
  137.     THEN  ;
  138.  
  139. ' err_src  -> dflt-die
  140.  
  141. :f FLUSH_TWstr
  142.     pos: TWstr  0EXIT
  143.     lock: TWstr
  144.     all: TWstr insert: TW
  145.     unlock: TWstr
  146.     clear: TWstr  ;f
  147.  
  148.  
  149. : XEMIT        \ ( char -- )
  150.     TWport?
  151.     IF        +: TWstr
  152.     ELSE    (emit)
  153.     THEN  ;
  154.  
  155. : XCR
  156.     TWport?    
  157.     IF        RET xemit  flush_TWstr
  158.     ELSE    (cr)
  159.     THEN  ;
  160.  
  161. : XTYP        \ ( addr len -- )
  162.     TWport?
  163.     IF        add: TWstr
  164.     ELSE    (type)
  165.     THEN  ;
  166.  
  167. : XSPS        \ Replacement for SPACES
  168.     TWport?
  169.     IF        dup 0<= IF  drop  EXIT  THEN
  170.             pad swap 2dup bl fill
  171.             add: TWstr
  172.     ELSE    (spaces)
  173.     THEN  ;
  174.  
  175. : XQUIT
  176.     RP0  RP!  eventloop  ;        \ QUIT will now always come back to EventLoop
  177.  
  178.  
  179. :f NEWVECS
  180.     ['] xemit    -> emitvec
  181.     ['] xcr        -> crvec
  182.     ['] xtyp    -> typevec
  183.     ['] xsps     -> spvec
  184.     ['] xemit     -> echovec
  185.     ['] setTW    -> setfWind 
  186.     ['] xquit    -> quitvec
  187.     ['] bye+    -> byevec
  188. ;f
  189.  
  190. :f OLDVECS
  191.     ['] (emit)        -> emitvec
  192.     ['] (cr)        -> crvec
  193.     ['] (type)        -> typevec
  194.     ['] (spaces)    -> spvec
  195.     ['] (emit)        -> echovec
  196.     ['] (sf)        -> setfWind
  197. \    0                -> quitvec        \ mh May94 - quit doesn't get changed any more
  198.     ['] bye            -> byevec
  199. ;f
  200.  
  201.  
  202. :f RUN_TE
  203.     load: TEFwindMod  lock: TEFwindMod        \ May have been purged
  204.     new: TWstr     \ 31Jan94 DBH
  205.     TW  do_run_TE
  206. ;f
  207.  
  208. :f setTW        select: TW  set: TW  enable: TW  ;f
  209.  
  210.  
  211.  
  212. \        ================= start of QE-related code ===================
  213.  
  214. \ The following words are called from QE, by QE sending us a string to
  215. \ EVALUATE.
  216.  
  217. \ StackClear clears the stack - we don't do the actual clear straight away,
  218. \ since the Mops system might have a variable number of cells in use.
  219. \ Instead we set clrStk? true, so that we'll handle it when our window TW
  220. \ gets idle: or update:, when things are consistent.
  221.  
  222. : STACKCLEAR
  223.     true -> clrStk?  ;
  224.  
  225.  
  226. \ ClrWind is used by the QE and Mops menu item "Clear Window".
  227.  
  228. : ClrWind
  229.     fWind?
  230.     IF      cls
  231.     ELSE    selAll: TW  clear: TW
  232.             actW TW <>        \ this seems to be necessary if TW isn't frontmost
  233.             IF    getRect: TW  put: tempRect  clear: tempRect  THEN
  234.     THEN  ;
  235.  
  236.  
  237. \ Now we have the words which support high-level events from Quick Edit.
  238. \ (Note these aren't AppleEvents.)
  239. \ Thanks to Doug Hoffman for these.
  240.  
  241.  
  242. : DoHLevent     \ ( -- b )
  243.     msgClass: fEvent  'type TEXT  =  \ a simple check for proper class
  244.     IF
  245.         msgID: fEvent  put: QEhand  \ message ID is merely the handle from QE
  246.         ptr: QEhand  size: QEhand  put: QEstr
  247.         evalFromQE  fWind? NIF  update: TW cr THEN     \ 01Feb94 DBH  Need the cr to insert: tw
  248.         true            \ we did handle the event
  249.     ELSE
  250.         false            \ we did not handle the event
  251.     THEN
  252.     ;
  253.  
  254. : InitQE
  255.     instld?  ?EXIT            \ Mustn't do this in installed apps
  256.     true -> resume?
  257.     ['] DoHLevent -> HLeventVec
  258.     new: QEstr
  259.     ;
  260.  
  261. ' InitQE add: init_actions
  262.  
  263.  
  264. \        =========== End of QE-related code ==================
  265.  
  266.  
  267.     0    value    TEMPA5        \ Used by DebugMod while we're getting
  268.                             \  addressable.  Must be in main dic.
  269.     0    value    LAST_TIME    \ These 3 are used by DebugMod when profiling.
  270.     0    value    NOW
  271.     0    value    THIS_BP
  272.  
  273. from DEBUGMOD    import{  in notin (see) see debug unbug resume show
  274.              profile  showp  }
  275.  
  276. from INSTLMOD    import{  installWind  }
  277.  
  278. \ Feb96 BLB:
  279. :a install                \ - remains "install" for 'command line' use
  280.     disable: menuBar    \ - else reselection could happen?
  281.     disable: TW
  282.     installwind
  283.     enable: menuBar
  284.     enable: TW
  285. ;a
  286.  
  287. from  UTILMOD    import{  .mods  .msgs  addmsg  removemsg  getindstr  }
  288.  
  289. from ALERTQMOD    import{  (al)  }
  290.  
  291. xts{  aboutVec  doDsk  }                    1  init: appleMen
  292.  
  293. xts{  L null doSave stdSave null byevec  }    2  init: FileMen
  294.  
  295. xts{  words doOlist doClist  }                4  init: ListMen
  296.  
  297. xts{  .paths  .room  .mods  }                5  init: ShowMen
  298.  
  299. xts{  LEcho stackClear ClrWind  null install doPurge  }
  300.                                             6  init: UtilMen
  301.  
  302.  
  303. : RUN        \ System startup word for the Mops development environment.
  304.     sysinit  run_FE  ;
  305.  
  306. ' run     -> objinit
  307.  
  308. 20 -> sleepticks            \ Default value - allows a time display
  309.                             \ to be updated reasonably.
  310.  
  311. false -> fwind?                \ Default is our new TE window.  This will now
  312.                             \  be permanent for the Mops development
  313.                             \  environment.
  314.  
  315. compile: FEmod
  316. compile: utilmod
  317. compile: debugmod
  318. compile: instlmod
  319.  
  320.  
  321. cr cr cr
  322. .( The Mops system is compiled.  Now save the dictionary, by typing e.g.) cr
  323. .( save Mops.dic) cr
  324. .( then type bye to quit, and after that you'll be able to fire up the) cr
  325. .( newly-compiled dictionary.)  cr cr
  326.  
  327.